home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xlib / client.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-10-13  |  11.1 KB  |  386 lines
  1. #include "xlib.h"
  2.  
  3. static Object Sym_Wm_Hints, Sym_Size_Hints;
  4.  
  5. static Object P_Iconify_Window (w, scr) Object w, scr; {
  6.     Check_Type (w, T_Window);
  7.     if (!XIconifyWindow (WINDOW(w)->dpy, WINDOW(w)->win,
  8.         Get_Screen_Number (WINDOW(w)->dpy, scr)))
  9.     Primitive_Error ("cannot iconify window");
  10.     return Void;
  11. }
  12.  
  13. static Object P_Withdraw_Window (w, scr) Object w, scr; {
  14.     Check_Type (w, T_Window);
  15.     if (!XWithdrawWindow (WINDOW(w)->dpy, WINDOW(w)->win,
  16.         Get_Screen_Number (WINDOW(w)->dpy, scr)))
  17.     Primitive_Error ("cannot withdraw window");
  18.     return Void;
  19. }
  20.  
  21. static Object P_Reconfigure_Wm_Window (w, scr, conf) Object w, scr, conf; {
  22.     unsigned long mask;
  23.  
  24.     Check_Type (w, T_Window);
  25.     mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec);
  26.     if (!XReconfigureWMWindow (WINDOW(w)->dpy, WINDOW(w)->win,
  27.         Get_Screen_Number (WINDOW(w)->dpy, scr), mask, &WC))
  28.     Primitive_Error ("cannot reconfigure window");
  29.     return Void;
  30. }
  31.  
  32. static Object P_Wm_Command (w) Object w; {
  33.     int i, ac;
  34.     char **av;
  35.     Object s, ret, t;
  36.     GC_Node2;
  37.  
  38.     Check_Type (w, T_Window);
  39.     Disable_Interrupts;
  40.     if (!XGetCommand (WINDOW(w)->dpy, WINDOW(w)->win, &av, &ac))
  41.     ac = 0;
  42.     Enable_Interrupts;
  43.     ret = t = P_Make_List (Make_Fixnum (ac), Null);
  44.     GC_Link2 (ret, t);
  45.     for (i = 0; i < ac; i++, t = Cdr (t)) {
  46.     s = Make_String (av[i], strlen (av[i]));
  47.     Car (t) = s;
  48.     }
  49.     GC_Unlink;
  50.     if (ac) XFreeStringList (av);
  51.     return ret;
  52. }
  53.  
  54. static String_List_To_Text_Property (x, ret) Object x; XTextProperty *ret; {
  55.     register i, n;
  56.     register char **s;
  57.     Object t;
  58.     Declare_C_Strings;
  59.  
  60.     Check_List (x);
  61.     n = Fast_Length (x);
  62.     Alloca (s, char**, n * sizeof (char *));
  63.     for (i = 0; i < n; i++, x = Cdr (x)) {
  64.     t = Car (x);
  65.     Make_C_String (t, s[i]);
  66.     }
  67.     if (!XStringListToTextProperty (s, n, ret))
  68.     Primitive_Error ("cannot create text property");
  69.     Dispose_C_Strings;
  70. }
  71.  
  72. static Object Text_Property_To_String_List (p) XTextProperty *p; {
  73.     int n;
  74.     register i;
  75.     char **s;
  76.     Object x, ret, t;
  77.     GC_Node2;
  78.  
  79.     if (!XTextPropertyToStringList (p, &s, &n))
  80.     Primitive_Error ("cannot convert from text property");
  81.     ret = t = P_Make_List (Make_Fixnum (n), Null);
  82.     GC_Link2 (ret, t);
  83.     for (i = 0; i < n; i++, t = Cdr (t)) {
  84.     x = Make_String (s[i], strlen (s[i]));
  85.     Car (t) = x;
  86.     }
  87.     GC_Unlink;
  88.     XFreeStringList (s);
  89.     return ret;
  90. }
  91.  
  92. static Object P_Get_Text_Property (w, a) Object w, a; {
  93.     XTextProperty ret;
  94.  
  95.     Check_Type (w, T_Window);
  96.     Check_Type (a, T_Atom);
  97.     Disable_Interrupts;
  98.     if (!XGetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &ret,
  99.         ATOM(a)->atom)) {
  100.     Enable_Interrupts;
  101.     return False;
  102.     }
  103.     Enable_Interrupts;
  104.     return Text_Property_To_String_List (&ret);
  105. }
  106.  
  107. static Object P_Set_Text_Property (w, prop, a) Object w, prop, a; {
  108.     XTextProperty p;
  109.  
  110.     Check_Type (w, T_Window);
  111.     Check_Type (a, T_Atom);
  112.     String_List_To_Text_Property (prop, &p);
  113.     XSetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &p, ATOM(a)->atom);
  114.     XFree ((char *)p.value);
  115.     return Void;
  116. }
  117.  
  118. static Object P_Wm_Protocols (w) Object w; {
  119.     Atom *p;
  120.     int i, n;
  121.     Object ret;
  122.     GC_Node;
  123.  
  124.     Check_Type (w, T_Window);
  125.     Disable_Interrupts;
  126.     if (!XGetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n))
  127.     Primitive_Error ("cannot get WM protocols");
  128.     Enable_Interrupts;
  129.     ret = Make_Vector (n, Null);
  130.     GC_Link (ret);
  131.     for (i = 0; i < n; i++) {
  132.     Object a = Make_Atom (p[i]);
  133.     VECTOR(ret)->data[i] = a;
  134.     }
  135.     XFree ((char *)p);
  136.     GC_Unlink;
  137.     return ret;
  138. }
  139.  
  140. static Object P_Set_Wm_Protocols (w, v) Object w, v; {
  141.     Atom *p;
  142.     int i, n;
  143.     Alloca_Begin;
  144.  
  145.     Check_Type (w, T_Window);
  146.     Check_Type (v, T_Vector);
  147.     n = VECTOR(v)->size;
  148.     Alloca (p, Atom*, n * sizeof (Atom));
  149.     for (i = 0; i < n; i++) {
  150.     Object a = VECTOR(v)->data[i];
  151.     Check_Type (a, T_Atom);
  152.     p[i] = ATOM(a)->atom;
  153.     }
  154.     if (!XSetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, p, n))
  155.     Primitive_Error ("cannot set WM protocols");
  156.     Alloca_End;
  157.     return Void;
  158. }
  159.  
  160. static Object P_Wm_Class (w) Object w; {
  161.     Object ret, x;
  162.     XClassHint c;
  163.     GC_Node;
  164.  
  165.     Check_Type (w, T_Window);
  166.     /*
  167.      * In X11.2 XGetClassHint() returns either 0 or Success, which happens
  168.      * to be defined as 0.  So until this bug is fixed, we must
  169.      * explicitly check whether the XClassHint structure has been filled.
  170.      */
  171.     c.res_name = c.res_class = 0;
  172.     Disable_Interrupts;
  173.     (void)XGetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
  174.     Enable_Interrupts;
  175.     ret = Cons (False, False);
  176.     GC_Link (ret);
  177.     if (c.res_name) {
  178.     x = Make_String (c.res_name, strlen (c.res_name));
  179.     Car (ret) = x;
  180.     XFree (c.res_name);
  181.     }
  182.     if (c.res_class) {
  183.     x = Make_String (c.res_class, strlen (c.res_class));
  184.     Cdr (ret) = x;
  185.     XFree (c.res_class);
  186.     }
  187.     GC_Unlink;
  188.     return ret;
  189. }
  190.  
  191. static Object P_Set_Wm_Class (w, name, class) Object w, name, class; {
  192.     XClassHint c;
  193.     Declare_C_Strings;
  194.  
  195.     Check_Type (w, T_Window);
  196.     Make_C_String (name, c.res_name);
  197.     Make_C_String (class, c.res_class);
  198.     XSetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
  199.     Dispose_C_Strings;
  200.     return Void;
  201. }
  202.  
  203. static Object P_Set_Wm_Command (w, cmd) Object w, cmd; {
  204.     register i, n;
  205.     register char **argv;
  206.     Object c;
  207.     Declare_C_Strings;
  208.  
  209.     Check_Type (w, T_Window);
  210.     Check_List (cmd);
  211.     n = Fast_Length (cmd);
  212.     Alloca (argv, char**, n * sizeof (char *));
  213.     for (i = 0; i < n; i++, cmd = Cdr (cmd)) {
  214.     c = Car (cmd);
  215.     Make_C_String (c, argv[i]);
  216.     }
  217.     XSetCommand (WINDOW(w)->dpy, WINDOW(w)->win, argv, n);
  218.     Dispose_C_Strings;
  219.     return Void;
  220. }
  221.  
  222. static Object P_Wm_Hints (w) Object w; {
  223.     XWMHints *p;
  224.  
  225.     Check_Type (w, T_Window);
  226.     Disable_Interrupts;
  227.     p = XGetWMHints (WINDOW(w)->dpy, WINDOW(w)->win);
  228.     Enable_Interrupts;
  229.     if (p) {
  230.     WMH = *p;
  231.     XFree ((char *)p);
  232.     } else {
  233.     WMH.flags = 0;
  234.     }
  235.     return Record_To_Vector (Wm_Hints_Rec, Wm_Hints_Size, Sym_Wm_Hints,
  236.     WINDOW(w)->dpy, (unsigned long)WMH.flags);
  237. }
  238.  
  239. static Object P_Set_Wm_Hints (w, h) Object w, h; {
  240.     unsigned long mask;
  241.  
  242.     Check_Type (w, T_Window);
  243.     mask = Vector_To_Record (h, Wm_Hints_Size, Sym_Wm_Hints, Wm_Hints_Rec);
  244.     WMH.flags = mask;
  245.     XSetWMHints (WINDOW(w)->dpy, WINDOW(w)->win, &WMH);
  246.     return Void;
  247. }
  248.  
  249. static Object P_Size_Hints (w, a) Object w, a; {
  250.     long supplied;
  251.  
  252.     Check_Type (w, T_Window);
  253.     Check_Type (a, T_Atom);
  254.     Disable_Interrupts;
  255.     if (!XGetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, &supplied,
  256.         ATOM(a)->atom))
  257.     SZH.flags = 0;
  258.     if (!(supplied & PBaseSize))
  259.     SZH.flags &= ~PBaseSize;
  260.     if (!(supplied & PWinGravity))
  261.     SZH.flags &= ~PWinGravity;
  262.     Enable_Interrupts;
  263.     if ((SZH.flags & (PPosition|USPosition)) == (PPosition|USPosition))
  264.     SZH.flags &= ~PPosition;
  265.     if ((SZH.flags & (PSize|USSize)) == (PSize|USSize))
  266.     SZH.flags &= ~PSize;
  267.     return Record_To_Vector (Size_Hints_Rec, Size_Hints_Size, Sym_Size_Hints,
  268.     WINDOW(w)->dpy, (unsigned long)SZH.flags);
  269. }
  270.  
  271. static Object P_Set_Size_Hints (w, a, h) Object w, a, h; {
  272.     unsigned long mask;
  273.  
  274.     Check_Type (w, T_Window);
  275.     Check_Type (a, T_Atom);
  276.     bzero ((char *)&SZH, sizeof (SZH));        /* Not portable? */
  277.     mask = Vector_To_Record (h, Size_Hints_Size, Sym_Size_Hints,
  278.     Size_Hints_Rec);
  279.     if ((mask & (PPosition|USPosition)) == (PPosition|USPosition))
  280.     mask &= ~PPosition;
  281.     if ((mask & (PSize|USSize)) == (PSize|USSize))
  282.     mask &= ~PSize;
  283.     SZH.flags = mask;
  284.     XSetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom);
  285.     return Void;
  286. }
  287.  
  288. static Object P_Icon_Sizes (w) Object w; {
  289.     XIconSize *p;
  290.     int i, n;
  291.     Object v;
  292.     GC_Node;
  293.     
  294.     Check_Type (w, T_Window);
  295.     Disable_Interrupts;
  296.     if (!XGetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n))
  297.     n = 0;
  298.     Enable_Interrupts;
  299.     v = Make_Vector (n, Null);
  300.     GC_Link (v);
  301.     for (i = 0; i < n; i++) {
  302.     register XIconSize *q = &p[i];
  303.     Object t = P_Make_List (Make_Fixnum (6), Null);
  304.     VECTOR(v)->data[i] = t;
  305.     Car (t) = Make_Fixnum (q->min_width); t = Cdr (t);
  306.     Car (t) = Make_Fixnum (q->min_height); t = Cdr (t);
  307.     Car (t) = Make_Fixnum (q->max_width); t = Cdr (t);
  308.     Car (t) = Make_Fixnum (q->max_height); t = Cdr (t);
  309.     Car (t) = Make_Fixnum (q->width_inc); t = Cdr (t);
  310.     Car (t) = Make_Fixnum (q->height_inc);
  311.     }
  312.     GC_Unlink;
  313.     if (n > 0)
  314.     XFree ((char *)p);
  315.     return v;
  316. }
  317.  
  318. static Object P_Set_Icon_Sizes (w, v) Object w, v; {
  319.     register i, n;
  320.     XIconSize *p;
  321.     Alloca_Begin;
  322.  
  323.     Check_Type (w, T_Window);
  324.     Check_Type (v, T_Vector);
  325.     n = VECTOR(v)->size;
  326.     Alloca (p, XIconSize*, n * sizeof (XIconSize));
  327.     for (i = 0; i < n; i++) {
  328.     register XIconSize *q = &p[i];
  329.     Object t = VECTOR(v)->data[i];
  330.     Check_List (t);
  331.     if (Fast_Length (t) != 6)
  332.         Primitive_Error ("invalid argument: ~s", t);
  333.     q->min_width = Get_Integer (Car (t)); t = Cdr (t);
  334.     q->min_height = Get_Integer (Car (t)); t = Cdr (t);
  335.     q->max_width = Get_Integer (Car (t)); t = Cdr (t);
  336.     q->max_height = Get_Integer (Car (t)); t = Cdr (t);
  337.     q->width_inc = Get_Integer (Car (t)); t = Cdr (t);
  338.     q->height_inc = Get_Integer (Car (t));
  339.     }
  340.     XSetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, p, n);
  341.     Alloca_End;
  342.     return Void;
  343. }
  344.  
  345. static Object P_Transient_For (w) Object w; {
  346.     Window win;
  347.  
  348.     Disable_Interrupts;
  349.     if (!XGetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, &win))
  350.     win = None;
  351.     Enable_Interrupts;
  352.     return Make_Window (0, WINDOW(w)->dpy, win);
  353. }
  354.  
  355. static Object P_Set_Transient_For (w, pw) Object w, pw; {
  356.     Check_Type (w, T_Window);
  357.     XSetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, Get_Window (pw));
  358.     return Void;
  359. }
  360.  
  361. init_xlib_client () {
  362.     Define_Symbol (&Sym_Wm_Hints, "wm-hints");
  363.     Define_Symbol (&Sym_Size_Hints, "size-hints");
  364.     Define_Primitive (P_Iconify_Window,   "iconify-window",    2, 2, EVAL);
  365.     Define_Primitive (P_Withdraw_Window,  "withdraw-window",   2, 2, EVAL);
  366.     Define_Primitive (P_Reconfigure_Wm_Window, 
  367.             "xlib-reconfigure-wm-window",          3, 3, EVAL);
  368.     Define_Primitive (P_Wm_Command,       "wm-command",        1, 1, EVAL);
  369.     Define_Primitive (P_Get_Text_Property,"get-text-property", 2, 2, EVAL);
  370.     Define_Primitive (P_Set_Text_Property,"set-text-property!",3, 3, EVAL);
  371.     Define_Primitive (P_Wm_Protocols,     "wm-protocols",      1, 1, EVAL);
  372.     Define_Primitive (P_Set_Wm_Protocols, "set-wm-protocols!", 2, 2, EVAL);
  373.     Define_Primitive (P_Wm_Class,         "wm-class",          1, 1, EVAL);
  374.     Define_Primitive (P_Set_Wm_Class,     "set-wm-class!",     3, 3, EVAL);
  375.     Define_Primitive (P_Set_Wm_Command,   "set-wm-command!",   2, 2, EVAL);
  376.     Define_Primitive (P_Wm_Hints,         "xlib-wm-hints",     1, 1, EVAL);
  377.     Define_Primitive (P_Set_Wm_Hints,     "xlib-set-wm-hints!",2, 2, EVAL);
  378.     Define_Primitive (P_Size_Hints,       "xlib-wm-size-hints",2, 2, EVAL);
  379.     Define_Primitive (P_Set_Size_Hints,   
  380.             "xlib-set-wm-size-hints!",             3, 3, EVAL);
  381.     Define_Primitive (P_Icon_Sizes,       "icon-sizes",        1, 1, EVAL);
  382.     Define_Primitive (P_Set_Icon_Sizes,   "set-icon-sizes!",   2, 2, EVAL);
  383.     Define_Primitive (P_Transient_For,    "transient-for",     1, 1, EVAL);
  384.     Define_Primitive (P_Set_Transient_For,"set-transient-for!",2, 2, EVAL);
  385. }
  386.